home *** CD-ROM | disk | FTP | other *** search
/ The Programmer Disk / The Programmer Disk (Microforum).iso / xpro / c4 / pro2 / 1n04045a < prev    next >
Text File  |  1990-08-08  |  1KB  |  71 lines
  1.  
  2.  
  3.  
  4. const
  5.     HT = chr(9);
  6.     CR = chr(13);
  7.     MINLONGINT = -MAXLONGINT - 1;
  8.     SPACES = [' ', HT, CR];
  9.  
  10. procedure longval
  11.     (s : string; var v : longint; var code : integer);
  12.     var
  13.         c : char;
  14.         digit, i : integer;
  15.         neg, overflow : boolean;
  16.         n : longint;
  17.  
  18.     function next : char;
  19.         begin
  20.         if i < length(s) then
  21.             begin
  22.             inc(i);
  23.             next := s[i];
  24.             end
  25.         else
  26.             next := chr(0);
  27.         end;
  28.  
  29.     begin
  30.     i := 0;
  31.     c := next;
  32.     while c in SPACES do
  33.         c := next;
  34.     neg := FALSE;
  35.     if c = '+' then
  36.         c := next
  37.     else if c = '-' then
  38.         begin
  39.         neg := TRUE;
  40.         c := next;
  41.         end;
  42.     if not (c in ['0' .. '9']) then
  43.         begin
  44.         code := i;
  45.         exit;
  46.         end;
  47.     n := 0;
  48.     overflow := FALSE;
  49.     while c in ['0' .. '9'] do
  50.         begin
  51.         digit := ord(c) - ord('0');
  52.         if n < (MINLONGINT + digit) div 10 then
  53.             overflow := TRUE;
  54.         n := n * 10 - digit;
  55.         c := next;
  56.         end;
  57.     if not neg then
  58.         begin
  59.         n := -n;
  60.         if n < 0 then
  61.             overflow := TRUE;
  62.         end;
  63.     v := n;
  64.     if c <> chr(0) then
  65.         code := i
  66.     else if overflow then
  67.         code := i + 1
  68.     else
  69.         code := 0;
  70.     end;
  71.